home *** CD-ROM | disk | FTP | other *** search
/ The PC-SIG Library 9 / The PC-SIG Library on CD ROM - Ninth Edition.iso / 301_400 / DISK0324 / DISK0324.ZIP / LIFE.PAS < prev    next >
Pascal/Delphi Source File  |  1984-06-12  |  3KB  |  112 lines
  1. PROGRAM LIFE;
  2. { Simulation of Conway's game of Life on a bounded grid. }
  3. { From Data Structures and Program Design by Robert Kruse  Prentice Hall }
  4. { Typed in by: Malcolm McCorquodale. }
  5. { Version 1. Page 6. }
  6. CONST
  7.      MAXROW = 10;      { max # of rows allowed }
  8.      MAXCOL = 80;      { max # of cols allowed }
  9. TYPE
  10.      ROW = 1..MAXROW;
  11.      COL = 1..MAXCOL;
  12.      STATUS = (DEAD,ALIVE);
  13.      GRID = ARRAY[ROW,COL] OF STATUS;
  14. VAR
  15.      MAP, NEWMAP : GRID;
  16.      I : ROW;
  17.      J : COL;
  18.      GENERATION, LASTGENERATION : INTEGER;
  19.  
  20. {--------------------------------------------}
  21.  
  22. PROCEDURE INITIALIZE;
  23. VAR
  24.      X,Y : INTEGER;    { COORDINATES OF CELL }
  25. BEGIN
  26.      WRITELN ('This program is a simulation of the game of life.');
  27.      WRITELN ('Enter the number of generations to run.');
  28.      READLN (LASTGENERATION);
  29.      IF LASTGENERATION <= 0 THEN WRITELN ('No output for 0 generations.');
  30.      FOR X := 1 TO MAXROW DO
  31.         FOR Y := 1 TO MAXCOL DO
  32.            MAP[X,Y] := DEAD;
  33.      WRITELN ('On each line give a pair of coordinates for a living cell.');
  34.      WRITELN ('Terminate the list by entering a 0 for X and Y');
  35.      READLN (X,Y);
  36.  
  37.      WHILE X <> 0 DO
  38.      BEGIN
  39.         IF (X>=1) AND (X<=MAXROW) AND (Y>=1) AND (Y<=MAXCOL)
  40.            THEN MAP[X,Y] := ALIVE
  41.            ELSE WRITELN ('Values out of range.');
  42.         READLN (X,Y);
  43.         END
  44. END;
  45.  
  46. {--------------------------------------------}
  47.  
  48. PROCEDURE WRITEMAP;
  49. CONST
  50.      FULL = '*';
  51.      EMPTY = ' ';
  52. VAR
  53.      X : ROW;
  54.      Y : COL;
  55. BEGIN
  56.      CLRSCR;
  57.      WRITELN ('The map at generation',generation:5,' is  below');
  58.      FOR X := 1 TO MAXROW DO
  59.      BEGIN
  60.         FOR Y := 1 TO MAXCOL DO
  61.            IF MAP[X,Y] = ALIVE THEN WRITE (FULL)
  62.                                ELSE WRITE (EMPTY);
  63.         WRITELN;
  64.      END      { Processing row X }
  65. END;
  66.  
  67. {--------------------------------------------}
  68.  
  69. FUNCTION NEIGHBORCOUNT (I:ROW;J:COL):INTEGER;
  70. VAR
  71.      X, XLOW, XHIGH : ROW;
  72.      Y, YLOW, YHIGH : COL;
  73.      COUNT : INTEGER;
  74. BEGIN
  75.      IF I = 1 THEN XLOW := 1
  76.               ELSE XLOW := I - 1;
  77.      IF I = MAXROW THEN XHIGH := 1
  78.                    ELSE XHIGH := I + 1;
  79.      IF J = 1 THEN YLOW := 1
  80.               ELSE YLOW := J - 1;
  81.      IF J = MAXCOL THEN YHIGH := J
  82.                    ELSE YHIGH := J + 1;
  83.      COUNT := 0;
  84.      FOR X := XLOW TO XHIGH DO
  85.         FOR Y := YLOW TO YHIGH DO
  86.            IF MAP[X,Y] = ALIVE THEN COUNT := COUNT + 1;
  87.      IF MAP [I,J] = ALIVE THEN COUNT := COUNT - 1;
  88.      NEIGHBORCOUNT := COUNT;
  89. END;
  90.  
  91. {--------------------------------------------}
  92.  
  93. BEGIN
  94.      INITIALIZE;
  95.      GENERATION := 0;
  96.      WRITEMAP;
  97.      FOR GENERATION := 1 TO LASTGENERATION DO
  98.      BEGIN
  99.         FOR I := 1 TO MAXROW DO FOR J := 1 TO MAXCOL DO
  100.            CASE NEIGHBORCOUNT(I,J) OF
  101.               0,1   : NEWMAP[I,J] := DEAD;
  102.               2     : NEWMAP[I,J] := MAP[I,J];
  103.               3     : NEWMAP[I,J] := ALIVE;
  104.               4..8  : NEWMAP[I,J] := DEAD
  105.               END;
  106.         FOR I := 1 TO MAXROW DO FOR J := 1 TO MAXCOL DO
  107.            MAP[I,J] := NEWMAP[I,J];
  108.         WRITEMAP;
  109.      END      { Processing one generation }
  110. END.
  111.  
  112.